perm filename TABLA.OLD[TAB,LCS] blob sn#213106 filedate 1976-05-17 generic text, type T, neo UTF8
00100	C CONVERTS LUTE TABLATURE TO STANDARD INPUT FOR MS.
00200	
00300		DIMENSION I(72),IQ(72),LET(14),NUM(8),LIST(14),KLST(8)
00400		1,RI(72),STR(50),FOR(3)
00500	C NO MORE THAN 50 NOTES PER FILE.
00600	C NOTE: USE 'C' FOR r AND 'Q' FOR k. (R=REST, K=KEY SIG.)
00700	C ON THE OTHER HAND!  USE 'Z' FOR MEASURE LINES ('M' IS TABLATURE ITEM)
00800		DATA LET/'A','B','C','D','E','F','G','H','I','J','Q',
00900		1 'L','M','N'/,NUM/'1','2','3','4','5','6','7','8'/
01000		1,LSL/'/'/,IBLA/' '/,ICOL/':'/,ISEMI/';'/,MIN/'-'/
01100		1,IR/'R'/,IX/'X'/,IZ/'Z'/,M100/100/
01200		1,LIST/'A','B','B','C','C','D','E','E','F','F',
01300		1 'G','G','A','B'/,IS/'S'/,IK/'K'/
01400		1,KLST/'B','E','A','D', 'F','C','G','D'/
01500		1,FOR/0,',F4.2',',A1)'/ ,F3/'(F2.0'/,F4/'(F3.0'/
01600		EQUIVALENCE (ID,LET(4)),(IF,LET(6)),(IM,LET(13)),(IN,LET(14))
01700		1,(RI,I)
01800	
01900		TYPE 1
02000	1	FORMAT(' TYPE FILE NAME -- '$)
02100	2	FORMAT(A5)
02200		ACCEPT 2,NAME
02300		TYPE 3
02400		ACCEPT 2,NM2
02500	3	FORMAT(' TYPE OUTPUT NAME -- '$)
02600	20	FORMAT(I,72A1)
02700	22	FORMAT(72A1)
02800	222	FORMAT(1X72A1)
02900	2222	FORMAT(F5.0,F4.2,A1)
03000		IF(NM2.EQ.IBLA)NM2='TABL'
03100		CALL IFILE(1,NAME)
03200		CALL OFILE(21,NM2)
03300		ISGN=0
03400		JND=0
03500	
03600	240	MODE=-1
03700		READ(1,20,END=102)L,I
03800		TYPE 20,L,I
03900	C READS SOS LINE NUMBERS
04000	
04100		IMIN=0
04200		ITOT=0
04300		ICHRD=0
04400		NN=1
04500	
04600		NTS=-1
04700	21	N=1
04800	8	J=0 
04900		NX=0
05000		NL=-1
05100	31	JM=M
05200		M=I(N)
05300		IF(M.EQ.LSL)GO TO 10
05400		IF(M.EQ.ICOL)GO TO 10
05500		IF(M.EQ.ISEMI)GO TO 13
05600		IF(M.NE.IBLA)GO TO 36
05700		IF(JM.EQ.M)GO TO 35
05800	C NEVER MORE THAN ONE BLANK AT A TIME.
05900		GO TO 7
06000		
06100	36	DO 32 K=1,14
06200	32	IF(M.EQ.LET(K))GO TO 11
06300		IF(M.NE.IS.AND.M.NE.IR)GO TO 76
06400	C  FINDS 'S' OR 'R'
06500		LETX=0
06600		NX=NX+1
06700		IQ(NX)=M
06800		N=N+1
06900		M=I(N)
07000		GO TO 7
07100	C  FOR 'SD' AND 'SU', 'RD', 'RI'
07200	
07300	76	IF(M.EQ.'0')GO TO 74
07400	C  BASS STRINGS ARE 0, -1, -2, ETC.  -- ALSO USE /SD/
07500		IF(M.NE.MIN)GO TO 33
07600	
07700	9	IMIN=-1
07800		LETX=-1
07900		J=0
08000	C  SO OCT. NUM WILL APPEAR FOR HIGH NOTES AFTER BASS STRINGS
08100		N=N+1
08200		M=I(N)
08300	33	DO 34 K=1,8
08400	34	IF(M.EQ.NUM(K))GO TO 12
08500		LETX=0
08600		IF(M.NE.IK)GO TO 37
08700		ISGN=1
08800	C FOUND A KSIG
08900	39	NX=NX+1
09000		IQ(NX)=M
09100		N=N+1
09200		M=I(N)
09300		IF(M.NE.MIN)GO TO 33
09400	C FOUND MINUS
09500		ISGN=-1
09600		GO TO 39
09700	
09800	74	L=7 
09900		J=0
10000		LETX=-1
10100	77	NX=NX+1
10200	C  FOR OCTAVE NUM
10300		IQ(NX)=LET(L)
10400		NX=NX+1
10500		M=3
10600		IF(L.LT.3)M=2
10700		IQ(NX)=NUM(M)
10800		GO TO 35
10900	75	L=7-K
11000		IMIN=0
11100		GO TO 77
11200	
11300	37	IF(M.EQ.IZ)M=IM
11400	C  CHANGE Z (MEASURE) TO M
11500		GO TO 7
11600	
11700	35	N=N+1
11800		IF(N.LT.72)GO TO 31
11900		IF(NX.GT.72)GO TO 101
12000		WRITE(21,22)(IQ(K),K=1,NX)
12100		TYPE 222,(IQ(K),K=1,NX)
12200	14	IF(MODE)GO TO 140
12300		MODE=MODE+1
12400		IF(MODE.EQ.3)GO TO 240
12500	C  FOR RESTART. DON'T PUT BASS STRS FIRST. ONLY 1 LN FOR BMS &SLRS
12600	140	READ(1,20,END=100)L,I
12700		TYPE 20,L,I
12800		IF(NTS)GO TO 21
12900	C  NEXT FOR LINES AFTER NOTES.
13000	C NEXT FOR STRING NUMS.
13100		IF(I(1).NE.IBLA)GO TO 70
13200	C TO SKIP ALL RHYTH LINES
13300		IF(MODE.GE.0)GO TO 70
13400	C SO WE WON'T EVER COME BACK HERE
13500	73	L=0 
13600		NL=LSL
13700	CC	ITOT=ITOT-1
13800		FOR(1)=F3
13900		NA=0
14000		DO 71 K=1,ITOT
14100	C  ITOT = TOTAL NUM OF NOTES
14200		A=STR(K)
14300		IF(A)GO TO 71
14400		JJ=K
14500	171	JJ=JJ+1
14600		IF(STR(JJ).GT.0)GO TO 272
14700		IF(JJ.EQ.ITOT)NL=ISEMI
14800		GO TO 171
14900	272	NA=NA+1
15000		L=L+2
15100		RI(L-1)=NA
15200		RI(L)=A*.01
15300		IF(K.EQ.ITOT)NL=ISEMI
15400		IF(NA.GT.9)FOR(1)=F4
15500	CC71	WRITE(21,72)RI(L-1),RI(L),M
15600		TYPE 2222,RI(L-1),RI(L),NL
15700		WRITE(21,FOR)RI(L-1),RI(L),NL
15800	71	CONTINUE
15900		MODE=0
16000	C  NOW SET MODE COUNTER TO PREPARE FOR RESTART
16100		GO TO 14
16200	70	WRITE(21,22)(I(K),K=1,72)
16300		GO TO 14
16400	100	IF(NL.NE.ISEMI)GO TO 73
16500	102	STOP
16600	101	FORMAT(' TOO MUCH ON LINE')
16700		TYPE 101
16800		STOP
16900	
17000	11	NL=K
17100	C  THE NUMB. OF THE LETTER
17200		LETX=-1
17300		GO TO 35
17400	12	IF(ISGN.EQ.0)GO TO 47
17500	C NEXT FOR KSIG SETUP
17600		JFST=5
17700		IF(ISGN)JFST=1
17800		JND=JFST+K-1
17900		ISGN=0
18000	47	IF(IMIN)GO TO 75
18100	C JUMP FOR BASS STRINGS
18200		IF(NL)GO TO 7
18300		NN=K
18400	C  THE NUMBER
18500		GO TO 35
18600	
18700	C NEXT AFTER IT FOUND SLASH OR SEMICOLON
18800	13	NTS=0
18900	10	IF(LETX.EQ.0)GO TO 110
19000		ITOT=ITOT+1
19100	C  SAVE THE STRING NUM.
19200		NA=NN
19300		IF(ICHRD.EQ.ICOL)NA=-1
19400	C FLAG FOR CHORD NOTES (CAN'T SPECIFY STRING IN BEAMS SUBR.)
19500		STR(ITOT)=NA
19600		ICHRD=M
19700	110	IF(NL)GO TO 7
19800		JOCT=0
19900		GO TO(41,42,43,44,45,46),NN
20000	46	NA=0
20100		GO TO 5
20200	45	NA=5
20300	C THESE ARE ADDERS FOR 'LIST'
20400		GO TO 5
20500	44	NA=8
20600		GO TO 5
20700	43	NA=0
20800		GO TO 6
20900	C NOW ON THE UPPER 3 STRINGS
21000	42	NA=5
21100		GO TO 6
21200	41	NA=8
21300	6	JOCT=1
21400	C  THE OCTAVE ADDER
21500	5	NX=NX+1
21600		NB=NL+NA
21700	C PUT A NOTE AWAY
21800	18	L=LIST(NB)
21900		IQ(NX)=L
22000	C THE FOUND-NOTE FLAG
22100	C  SAVE THE STRING NUM.
22200	58	GO TO(51, 52,51,51, 55,51, 52,51,51, 55,51, 55,51, 52),NB
22300	C  FINDS FLAT OR SHARP --  WHAT ABOUT KSIG.
22400	52	K=IF
22500		GO TO 50
22600	55	K=IS
22700	50	IF(JND.EQ.0)GO TO 53
22800		DO 54 KA=JFST,JND
22900	54	IF(L.EQ.KLST(KA))GO TO 56
23000	C  LOOK FOR KSIG MATCH UP
23100		GO TO 53
23200	56	IF(K.NE.0)GO TO 57
23300		K=IN
23400	C MAKES A NATURAL
23500	53	NX=NX+1
23600		IQ(NX)=K
23700	57	NA=3
23800		NL=-1
23900		IF(NB.GT.3)NA=4
24000		NA=NA+JOCT
24100		IF(J.EQ.NA)GO TO 7
24200	C  AVOIDS REPEATING OCT. NUM
24300		J=NA
24400		NX=NX+1
24500		IQ(NX)=NUM(NA)
24600	7	NX=NX+1
24700		IQ(NX)=M
24800		IF(M.EQ.ISEMI)NTS=0
24900		GO TO 35
25000	51	K=0
25100		GO TO 50